perm filename XAP1[XAP,BGB] blob
sn#046322 filedate 1973-06-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
C00005 00003 FONT SPECIFICATION.
C00006 00004 XGP RASTER PAGE BUFFER.
C00008 00005 ALTERNATE PDP-10 MNEMONICS.
C00011 00006 START ADDRESS ENTRY.
C00014 00007 SUBR(BEGPROG) BEGIN PROGRAM.
C00016 00008 SUBR(PASS1)
C00017 00009 SUBR(PASS2)
C00020 00010 HTAB: LAC COL↔SUB LMAR TEXT HORIZONTAL TAB.
C00021 00011 SUBR(MKTABL) MAKE 2D BIT ADDRESSING TABLE IN 2ND SEGMENT.
C00025 00012 SUBR(XGPOUT) OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
C00028 00013 SUBR(PRINT) PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
C00031 ENDMK
C⊗;
TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
;JOB DATA AREA AND CORE MAP.
PDL: BLOCK 100 ;CONTROL PUSH DOWN.
PAT: BLOCK 100 ;PATCH AREA.
EXTERN JOBJDA ;140 END OF JOB DATA AREA.
EXTERN JOBFF ;121 TOP OF USED CORE POINTER.
EXTERN JOBSA ;120 XWD ORGINAL-TOP,START-ADDR.
EXTERN JOBREL ; 44 PHYSICAL TOP OF CORE IMAGE.
;PROCESSOR STATUS.
PASS:0 ;0 FOR PASS1, -1 FOR PASS2.
PMODE:0 ;PAGINATION MODE: 0 MANUAL, -1 AUTOMATIC.
WFMODE:0 ;WINDOW FILLING MODE: 0 TEXT, -1 GRAPHICS, +1 XGP.
CMODE:0 ;-1 COMMAND MODE. 0 TEXT MODE.
TJMODE:0 ;TEXT JUSTIFICATION MODE.
;0 CLIP, -1 AUTO-CRLF, +1 LRJUST, +2 RJUST, +3 CJUST.
CHAR:0 ;CURRENT CHARACTER.
CHRCNT:0 ;CHARACTERS REMAINING.
TXTPTR:0 ;TEXT POINTER.
TXTORG:0 ;TEXT ORIGIN.
TXTEND:0
EOF:0↔HIDDEN:0
BUGFLG:0 ;-1 WHEN DEBUGGING.
;DSK I/O DATA AREA.
FILNAM: 0 ;FILE NAME.
EXTION: 0↔0 ;EXTENSION.
PPPN: 0↔0 ;PROJECT-PROGRAMMER.
RPGFLG: 0
;FONT SPECIFICATION.
FONT: 1
FONTAB: BLOCK =45
FNTPPN: SIXBIT/XGPSYS/ ;DEFAULT FONT PPN
FNTNAM: 0 ;DEFAULT FONT NAMES.
SIXBIT/LPT/ ;1 LINE PRINTER.
SIXBIT/FIX13X/ ;2 FIXED WIDTH FONTS.
SIXBIT/FIX20/ ;3
SIXBIT/FIX25/ ;4
SIXBIT/FIX40/ ;5
SIXBIT/NGR13/ ;6 NEW GOTHIC ROMAN.
SIXBIT/NGR20/ ;7
SIXBIT/NGR25/ ;8
SIXBIT/NGR30/ ;9
SIXBIT/NGR40/ ;A
SIXBIT/BDR25/ ;B BODONI ROMAN
SIXBIT/BDI25/ ;C BODONI ITALIC
SIXBIT/BDR40/ ;D
SIXBIT/XMAS25/ ;E PSEUDO OLDE ENGLISH.
SIXBIT/SIGN57/ ;F
SIXBIT/GRK25/ ;G GREEK.
SIXBIT/SET1/ ;H TOVAR'S CREATION.
;XGP RASTER PAGE BUFFER.
ROW:0 ;XGP "PEN" POSITION.
COL:0
DROW:0 ;DELTA PEN POSITION FOR LINE FEED AND SPACE.
DCOL:0
QPAGE:0 ;QUARTER PAGE: 0, 1, 2, 3.
QLO:0↔QHI:0 ;QUARTER ROW LOW & QUARTER ROW HI.
ORGXGP:0 ;XGP BUFFER (1/4 OF A PAGE).
ENDXGP:0
;XGP RASTER DIMENSIONS.
WWIDTH←←=49 ;WORD WIDTH OF A ROW.
NCOLS←←(WWIDTH-1)*=36 ;NUMBER OF COLUMNS IS 1728.
MROWS←←=2048 ;NUMBER OF ROWS IS 2048.
BUFSIZ←←WWIDTH*MROWS/4 ;SIZE OF XGP BUFFER (ONE QUARTER PAGE).
;III BUFFER DISPLAY.
IIIDX: =1024
IIIDY: =1024
ROTDEL:0
SINE:0↔COSINE:1.0 ;ORIENTATION.
SCALEX:1.0↔SCALEY:1.0 ;DILATION.
;TEXT JUSTIFICATION PARAMETERS.
RMAR:NCOLS
LMAR:=200
ROWMIN:=200
ROWMAX:MROWS
;GRAPHICS WINDOW.
GWROWS:0 ;RASTER SIZE.
GWCOLS:0
GWROW0:0 ;RASTER ORIGIN.
GWCOL0:0
;ALTERNATE PDP-10 MNEMONICS.
DEFINE O(A,B){OPDEF A[B]}
O LIP,HLR↔O LAP,HRR↔O DIP,HRLM↔O DAP,HRRM
O ZIP,HRRZS↔O ZAP,HLLZS↔O WIP,HRROS↔O WAP,HRRZS
O CAR,HLRZ↔O LIPI,HRLI↔O LAPI,HRRI↔O DIPZ,HRLZM
O CDR,HRRZ↔O LACI,MOVEI↔O SLACI,MOVSI↔O DAPZ,HRRZM
O LAC,MOVE↔O LACN,MOVN↔O LACM,MOVM↔O SLAC,MOVS
O DAC,MOVEM↔O DACN,MOVNM↔O DACM,MOVMM↔O SDAC,MOVSM
O NIP,HLRE↔O NAP,HRRE↔O NIM,HRREI↔O GO,JRST
O FLOAT,FSC 233↔O FIXX,FIX 233000↔O DZM,SETZM
;SAIL LIKE SUBROUTINE LINKAGE.
↓P←←17
DEFINE SUBR(NAME){INTERN NAME↔↓NAME: ;}
DEFINE CALL(NAME,X1,X2,X3,X4){
IFDIF<><X1>{PUSH 17,X1↔IFDIF<><X2>{PUSH 17,X2
IFDIF<><X3>{PUSH 17,X3↔IFDIF<><X4>{PUSH 17,X4}}}}
PUSHJ 17,NAME}
DEFINE ARG1<-1(17)>↔DEFINE ARG2<-2(17)>
DEFINE ARG3<-3(17)>↔DEFINE ARG4<-4(17)>
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
DEFINE POP0J <POPJ 17,>
↓POP1J.:SUB 17,[2(2)]↔GO@2(17)↔DEFINE POP1J<GO POP1J.>
↓POP2J.:SUB 17,[3(3)]↔GO@3(17)↔DEFINE POP2J<GO POP2J.>
↓POP3J.:SUB 17,[4(4)]↔GO@4(17)↔DEFINE POP3J<GO POP3J.>
↓POP4J.:SUB 17,[5(5)]↔GO@5(17)↔DEFINE POP4J<GO POP4J.>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
DEFINE ACCUMULATORS(LIST){ACPTR←←2
FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){
FOR VARNAM⊂(LIST)<VARNAM: 0↔>}
;FATAL ERROR MESSAGE.
DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
%←←400000
;START ADDRESS ENTRY.
SA: TDCA↔SETA↔DAC RPGFLG↔CALLI ;SET RPG FLAG.
CAR JOBSA↔DAC JOBFF↔CORE↔JFCL ;CORE DOWN LOWER.
LACI =2047↔CORE2↔GO[
FATAL(<CAN'T GET A 2ND SEGMENT.>)]
LAC P,[IOWD 100,PDL] ;INITIALIZE TABLES
;RE-ENTRY ADDRESS.
REE: LACI .↔DAC 124
SKIPE RPGFLG↔JFCL ;RPG INITIALIZATION.
CALL(BEGPROG) ;PROGRAM INITIALIZATION.
;TWO PASS XEROX TEXT ASSEMBLER.
CALL(PASS1)
CALL(PASS2)
;END PROGRAM.
CALLI 0 ;FLUSH LIBRASCOPE.
LAC JOBFF↔CORE↔JFCL ;FLUSH CORE.
SETZ↔CORE2↔JFCL ;FLUSH UPPER SEGMENT.
EXIT
;____________________________________________________________________
SUBR(BEGPROG) ;BEGIN PROGRAM.
BEGIN BEGPROG
LACI 0↔UFBGET↔GO .+3
LACI 1↔UFBGET↔GO[FATAL(<CAN'T GET FASTBANDS.>)]
;DEFAULT INITIALIZE MARGINS.
LAC ROWMIN↔DAC ROW
LACI MROWS-=100↔DAC ROWMAX
LAC LMAR↔DAC LMAR↔DAC COL
LACI NCOLS↔DAC RMAR
;INITIALIZE SCANNER AND CORE ALLOCATION.
SETOM CMODE ;COMMAND MODE.
CALL(MKBUF) ;MAKE XGP BUFFER.
CALL(MKTABL) ;MAKE 2D BIT ADDRESS TABLE.
;DEFINE DEFAULT FONT.
SETZM FONTAB
LAC[XWD FONTAB,FONTAB+1]↔BLT FONTAB+9
LAC[SIXBIT/LPTFNT/]
HLLZM FILNAM↔DIPZ EXTION
LAC FNTPPN↔DAC PPPN
LACI 1↔DAC FONT
CALL(<DEFONT+1>)
;RESCAN COMMAND LINE FOR CHARACTERS RIGHT OF SEMI-COLON.
RESCAN↔INCHSL↔EXIT↔CAIN 15↔EXIT
CAIE";"↔GO .-5↔DZM CHRCNT
CDR JOBFF↔LIPI 440700
DAC TXTPTR↔DAC TXTORG
INCHSL 1↔EXIT
CAIN 1,"D"↔SETOM BUGFLG↔GO .+3
INCHSL 1↔GO .+4↔AOS CHRCNT
IDPB 1,0↔GO .-4↔DAC TXTEND
SKIPN BUGFLG↔POP0J
OUTSTR[ASCIZ/BEGIN./]↔INCHRW↔CRLF↔POP0J
BEND BEGPROG;________________________________________________________
SUBR(PASS1)
BEGIN PASS1
LAC TXTORG↔DAC TXTPTR
CDR 1,TXTEND↔CDR 0,TXTORG
SUB 1,0↔AOS 1↔IMULI 1,5↔DAC 1,CHRCNT
L1: SETQ(CHAR,{GETCHR})
SKIPGE CHRCNT↔GO L3
SKIPE CMODE↔GO L2
;TEXT MODE CHARACTER.
CAR A00(1)
CAIN 1,"~"↔SETOM CMODE
; SKIPE↔PUSHJ P,@0
GO L1
;COMMAND MODE CHARACTER.
L2: CDR A00(1)
CAIN 1,"F"↔GO[CALL(GETCHR)↔SETZM CMODE↔GO L1]
CAIN 1,"@"↔PUSHJ P,@0
GO L1
;END OF DOCUMENT.
L3: SETOM CMODE
POP0J
BEND PASS1;__________________________________________________________
SUBR(PASS2)
BEGIN PASS2
;START-OF-DOCUMENT.
LAC TXTORG↔DAC TXTPG#↔DZM EOF
CDR 1,TXTEND↔CDR 0,TXTORG
SUB 1,0↔AOS 1↔IMULI 1,5↔DAC 1,CHRCNT
LAC CHRCNT↔DAC SAVCNT#
;START-OF-PAGE.
L0: LACI =511↔DAC QHI↔DZM QLO↔DZM QPAGE ;1ST QUARTER PAGE.
L00: LAC TXTPG↔DAC TXTPTR ;TOP-OF-THE-PAGE.
LAC SAVCNT↔DAC CHRCNT
LAC ROWMIN↔DAC ROW
;START-OF-QUARTER-PAGE.
LAC ORGXGP↔DZM@↔DIP↔AOS↔BLT@ENDXGP ;CLEAR QUARTER PAGE.
SKIPN BUGFLG↔GO L1
OUTSTR[ASCIZ/QUARTER /]
LAC QPAGE↔IORI"0"↔OUTCHR↔CRLF
;PROCESS A CHARACTER.
L1: SETQ(CHAR,{GETCHR})
SKIPGE CHRCNT↔GO L3 ;END OF DOCUMENT.
JUMPE 1,L1
CAIN 1,14↔GO L3 ;FORM FEED.
SKIPE CMODE↔GO L2
CAR A00(1) ;TEXT MODE CHARACTER.
SKIPN↔LACI PRINT
PUSHJ P,@0↔GO L1
L2: CDR A00(1) ;COMMAND MODE CHARACTER.
SKIPE↔PUSHJ P,@0↔GO L1
;WRITE QUARTER-PAGE ON FAST BAND.
L3: LAC 1,QPAGE
LAC[0↔=784↔=1568↔0](1)↔DAC SECTOR
LAC ORGXGP↔DAC BUFPTR
LACI =25088↔DAC WRDCNT
LAC[0↔0↔0↔1](1)↔DAC BAND
FBWRT BUFPTR↔OUTSTR[ASCIZ/WARNING: FB WRITE ERROR./]
;ADVANCE TO NEXT QUARTER PAGE.
LACI =512↔ADDM QLO↔ADDM QHI
AOS 1,QPAGE↔CAIGE 1,4↔GO L00
;ADVANCE TO NEXT PAGE.
L4: CALL(XGPOUT)↔OUTSTR[ASCIZ/IS THIS PAGE OK ?/]↔INCHRW↔CAIN"N"↔GO L4
CRLF
LAC TXTPTR↔DAC TXTPG
LAC CHRCNT↔DAC SAVCNT
SKIPN EOF↔GO L0
POP0J
BEND PASS2;__________________________________________________________
HTAB: LAC COL↔SUB LMAR ;TEXT HORIZONTAL TAB.
LAC 16,DCOL↔SUBI 16,2 ;KLUDGE TO MAKE CRE DOCUMENT.
IDIV 16↔ANDCMI 7
ADDI 8↔IMUL 16↔ADD LMAR
DAC COL
POP0J
CRETURN:LAC LMAR ;TEXT CARRIAGE RETURN.
DAC COL
POP0J
LFEED: LAC DROW ;TEXT LINE FEED.
ADDM ROW
GO ROWCHK
SPACE: LAC DCOL↔ADDM COL
↑COLCHK:LAC COL↔CAMG RMAR↔GO ROWCHK ;COLUMN OVERFLOW - DEFAULT CRLF.
LAC LMAR↔DAC COL
LAC DROW↔ADDM ROW
↑ROWCHK:LAC ROW↔CAMGE ROWMAX↔POP0J ;ROW OVERFLOW -DEFAULT FF.
FFEED: SKIPA↔CALL(XGPOUT) ;FORM FEED.
LAC ROWMIN↔DAC ROW
LAC LMAR↔DAC COL↔POP0J
ESCAPE: SETOM CMODE↔POP0J
SUBR(MKTABL) ;MAKE 2D BIT ADDRESSING TABLE IN 2ND SEGMENT.
;TWO DIMENSION BIT ADDRESSING.
DEFINE DOT(R,C){HLLZ 1,%(C)↔ROT 1,6↔HRRI 1,@%(R)↔DPB 0,1}
COMMENT ⊗
The DOT macro places a bit at a given row and column of the
XGP buffer. The 2D bit address byte pointer is computed by twice
referencing a 2K table in which the Nth word contains the bytes
0:5(N div =36) 6:11(N mod =36) 12:17(01) 18:35(orgXGP+N*WWIDTH).
That is the left halfword of the Nth table entry contains the base
address of the Nth row; and the right halfword of the Nth table
entry contains a byte pointer to the Nth column. In the DOT macro,
the HLLZ and ROT instructions setup the column byte pointer and the
HRRI instruction (thru the magic of immediate indirect double
indexing) adds the right halfword of the Nth row table entry to the
byte pointer. The use of accumulator 1 is mandatory because of the
index-byte-size pun. The following subroutine initializes the table.⊗
BEGIN MKTABL;________________________________________________________
LAC[XWD L,1]↔BLT 11
LAC ORGXGP↔AOS↔TLO 4301↔PUSHJ P,3
LAP ORGXGP↔AOS↔LIPI 2,-=512↔PUSHJ P,3
LAP ORGXGP↔AOS↔LIPI 2,-=512↔PUSHJ P,3
LAP ORGXGP↔AOS↔LIPI 2,-=512↔GO 3
L: XWD -100,WWIDTH ;1 INCREMENT.
XWD -=512,% ;2 AOBJN TABLE POINTER.
DAC 0,(2) ;3
TLNN 0,7700 ;4 TEST FOR =36 OVERFLOW.
ADD 0,[144B11] ;5 INCREMENT COLUMN WORD COUNT.
ADD 0,1 ;6
AOBJN 2,3 ;7
POP0J ;8
BEND MKTABL;BGB 24 MAY 1973._________________________________________
SUBR(MKBUF) MAKE XGP BUFFER (ONE PHASE) 512 ROWS.
BEGIN MKBUF;------------------------------------------------------
;EXPAND CORE FOR XGP BUFFER.
CDR JOBFF↔DAC ORGXGP
ADDI BUFSIZ-1↔DAC ENDXGP
ADDI 3*WWIDTH+10↔DAC JOBFF↔ADDI =3000
CORE↔GO[FATAL(CAN'T GET CORE FOR XGP BUFFER)]
;CLEAR XGP BUFFER.
LAC 1,ORGXGP↔SETZM(1)
DIP 1,1↔AOS 1↔BLT 1,@JOBREL
POP0J
BEND MKBUF;BGB 27 JANUARY 1973.-----------------------------------
SUBR(XGPOUT) OUTPUT BUFFER TO XGP FROM SECONDARY STORAGE.
BEGIN XGPOUT;-----------------------------------------------------
BSIZ ←← =6272 ↔ BCNT ←← =16 ;BUFFER SIZE & NUMBER OF THEM.
SETZ 1,↔SEGNUM 1,↔DAC 1,MYSEG#↔DETSEG↔LOCK;DETACH SEGMENT.
OUTSTR[ASCIZ/PAGE TO XGP.../]
LAC ORGXGP↔DAC BUFORG↔ADDI 3*BSIZ↔DAC BUFEND
CAMLE JOBREL↔CORE↔JFCL
DZM BAND↔DZM SECTOR↔LAC BUFORG↔DAC BUFPTR
;XGP OUTPUT ONE PAGE.
INIT 2,117↔SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
/]↔ POP0J]↔LOCK↔LACI 3,BCNT ;THIS MANY DRUM BUFFERS PER PAGE.
;READ DRUM.
L1: LACI BSIZ↔DAC WRDCNT↔LAC BAND
FBREAD BUFPTR↔OUTSTR[ASCIZ/FAST BAND READ ERROR. /]
LACI =196↔ADDB SECTOR↔CAIG =2156↔GO .+3↔DZM SECTOR↔AOS BAND
;PUT XGP CONTROL WORD IN EACH ROW.
LAC[1B11+=48]↔LAC 1,BUFPTR↔LACI 2,=128
DAC(1)↔ADDI 1,=49↔SOJG 2,.-2
CAIE 3,BCNT↔GO L2
OUT 2,CUTARG↔SKIPA↔JFCL
;PRINT ON XGP.
L2: SLACI -BSIZ↔LAP BUFPTR↔SOS↔ASH 3,1↔DAC DUMARG(3)
OUT 2,DUMARG(3)↔SKIPA↔OUTSTR[ASCIZ/XGP ERROR /]↔ASH 3,-1
CAIE 3,1↔GO L3
OUT 2,CUTARG↔SKIPA↔JFCL↔GO L4
;ADVANCE TO NEXT BUFFER.
L3: LACI BSIZ↔ADDB BUFPTR↔CAMGE BUFEND↔GO L4
LAC BUFORG↔DAC BUFPTR
L4: SOJG 3,L1↔UNLOCK↔RELEASE 2,↔OUTSTR[ASCIZ/FINISHED./]↔CRLF
LAC 1,MYSEG↔JUMPE 1,.+3 ;RE-ATTACH SEGMENT.
ATTSEG 1,↔GO[OUTSTR[ASCIZ/ATTSEG FAILED. /]↔HALT .+1]
POP0J
;____________________________________________________________________
BUFORG:0↔BUFEND:0 ;XGP BUFFERS.
CUTARG: IOWD 2,HACK↔0
DUMARG:BLOCK BSIZ*2 + 4
HACK: 1B0+=30B11↔0 ;CHOP PAPER.
BEND XGPOUT;BGB 28 MAY 1973.--------------------------------------
BAND:0↔BUFPTR:0↔WRDCNT:=12544↔SECTOR:0 ;FB UUO ARGUMENT.
SUBR(PRINT) PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
BEGIN PRINT;------------------------------------------------------
ACCUMULATORS{G,B,B2,M,N,I}
LAC 1,FONT ;CURRENT FONT NUMBER.
SKIPN 2,FONTAB(1)↔POP0J ;FONT BASE ADDRESS.
LAC I,203(2) ;ROWS BETWEEN TOP AND BASE LINE.
ADD 2,CHAR ;POINTER INTO FONT'S CHARACTER TABLE.
CAR N,(2) ;COLS WIDE OF THE GLYPH.
CDR G,(2)↔SKIPN G↔POP0J ;EXIT WHEN NO CHARACTER.
ADD G,FONTAB(1)↔AOS G ;CHARACTER'S GLYPH POINTER.
CDR M,(G) ;ROWS HIGH OF THE GLYPH.
CAR 0,(G) ;ROWS FROM TOP TO FIRST ROW OF GLYPH.
SUB 0,I ;ROWS ABOVE CURRENT XGP PEN POSITION.
ADD 0,ROW↔SUB 0,QLO
IMULI WWIDTH
ADD ORGXGP↔DAPZ B ;WORD POINTER INTO XGP BUFFER.
LAC 0,COL↔IDIVI 0,=36 ;REMAINDER IN AC-1 !
AOS↔ADD B,0↔DAC B,B2 ;WORD POINTER INTO XGP BUFFER.
LAC 16,FONT↔CAIN 16,8 ;SPECIAL HACK FOR CRE MANUAL.
GO[LAC 16,DCOL↔SUBI 16,2↔ADDM 16,COL↔GO .+2]
ADDM N,COL ;UPDATE XGP PEN COLUMN POSITION.
TLO G,444400↔AOS G ;SETUP GLYPH BYTE POINTER.
CAILE N,=36↔GO[
IDIVI N,=36↔AOJA N,L0] ;WHEN CHARACTER WIDTH ≥ =36.
DPB N,[POINT 6,G,11] ;SIZE OF BYTE.
ADD 1,N↔SUBI 1,=36 ; =36 - CHRWID - REMAINDER
LACI N,1
L0: MOVNS 1↔DAP 1,L3 ;BYTE POSITION WITH RESPECT TO WORD BOUNDARYS.
;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.
L1: LAC I,N
L2: ILDB 0,G↔SETZ 1,
L3: LSHC 0,0
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 0,(B)
AOS B↔JUMPE 1,L4
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 1,(B)
L4: SOJG I,L2↔LAC B,B2
ADDI B,WWIDTH↔DAC B,B2
SOJG M,L1
POP0J
BEND PRINT;BGB 23 MAY 1973.---------------------------------------